home *** CD-ROM | disk | FTP | other *** search
/ Sprite 1984 - 1993 / Sprite 1984 - 1993.iso / src / lib / tcl / dist6.3 / tests / rename.test < prev    next >
Encoding:
Text File  |  1991-08-14  |  2.5 KB  |  68 lines
  1. # Commands covered:  rename
  2. #
  3. # This file contains a collection of tests for one or more of the Tcl
  4. # built-in commands.  Sourcing this file into Tcl runs the tests and
  5. # generates output for errors.  No output means no errors were found.
  6. #
  7. # Copyright 1991 Regents of the University of California
  8. # Permission to use, copy, modify, and distribute this
  9. # software and its documentation for any purpose and without
  10. # fee is hereby granted, provided that this copyright notice
  11. # appears in all copies.  The University of California makes no
  12. # representations about the suitability of this software for any
  13. # purpose.  It is provided "as is" without express or implied
  14. # warranty.
  15. #
  16. # $Header: /sprite/src/lib/tcl/tests/RCS/rename.test,v 1.4 91/08/14 11:45:18 ouster Exp $ (Berkeley)
  17.  
  18. if {[string compare test [info procs test]] == 1} then {source defs}
  19.  
  20. catch {rename r2 {}}
  21. proc r1 {} {return "procedure r1"}
  22. rename r1 r2
  23. test rename-1.1 {simple renaming} {
  24.     r2
  25. } {procedure r1}
  26. test rename-1.2 {simple renaming} {
  27.     list [catch r1 msg] $msg
  28. } {1 {invalid command name: "r1"}}
  29. rename r2 {}
  30. test rename-1.3 {simple renaming} {
  31.     list [catch r2 msg] $msg
  32. } {1 {invalid command name: "r2"}}
  33.  
  34. # The test below is tricky because it renames a built-in command.
  35. # It's possible that the test procedure uses this command, so must
  36. # restore the command before calling test again.
  37.  
  38. rename list l.new
  39. set a [catch list msg1]
  40. set b [l.new a b c]
  41. rename l.new list
  42. set c [catch l.new msg2]
  43. set d [list 111 222]
  44. test 2.1 {renaming built-in command} {
  45.     list $a $msg1 $b $c $msg2 $d
  46. } {1 {invalid command name: "list"} {a b c} 1 {invalid command name: "l.new"} {111 222}}
  47.  
  48. test rename-3.1 {error conditions} {
  49.     list [catch {rename r1} msg] $msg $errorCode
  50. } {1 {wrong # args: should be "rename oldName newName"} NONE}
  51. test rename-3.2 {error conditions} {
  52.     list [catch {rename r1 r2 r3} msg] $msg $errorCode
  53. } {1 {wrong # args: should be "rename oldName newName"} NONE}
  54. test rename-3.3 {error conditions} {
  55.     proc r1 {} {}
  56.     proc r2 {} {}
  57.     list [catch {rename r1 r2} msg] $msg
  58. } {1 {can't rename to "r2": command already exists}}
  59. test rename-3.4 {error conditions} {
  60.     catch {rename r1 {}}
  61.     catch {rename r2 {}}
  62.     list [catch {rename r1 r2} msg] $msg
  63. } {1 {can't rename "r1":  command doesn't exist}}
  64. test rename-3.5 {error conditions} {
  65.     catch {rename _non_existent_command {}}
  66.     list [catch {rename _non_existent_command {}} msg] $msg
  67. } {1 {can't delete "_non_existent_command": command doesn't exist}}
  68.